home *** CD-ROM | disk | FTP | other *** search
/ Nebula 2 / Nebula Two.iso / Apps / Astro / ephem / Source / compiler.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-12  |  15.5 KB  |  584 lines
  1. /* module to compile and execute a c-style arithmetic expression.
  2.  * public entry points are compile_expr() and execute_expr().
  3.  *
  4.  * one reason this is so nice and tight is that all opcodes are the same size
  5.  * (an int) and the tokens the parser returns are directly usable as opcodes,
  6.  * for the most part. constants and variables are compiled as an opcode
  7.  * with an offset into the auxiliary opcode tape, opx.
  8.  */
  9.  
  10. #include <math.h>
  11. #include <ctype.h>
  12. #ifdef VMS
  13. #include <stdlib.h>
  14. #endif
  15. #ifdef NeXT
  16. # include <stdlib.h>
  17. #endif
  18. #include "screen.h"
  19.  
  20. /* parser tokens and opcodes, as necessary */
  21. #define    HALT    0    /* good value for HALT since program is inited to 0 */
  22. /* binary operators (precedences in table, below) */
  23. #define    ADD    1
  24. #define    SUB    2
  25. #define    MULT    3
  26. #define    DIV    4
  27. #define    AND    5
  28. #define    OR    6
  29. #define    GT    7
  30. #define    GE    8
  31. #define    EQ    9
  32. #define    NE    10
  33. #define    LT    11
  34. #define    LE    12
  35. /* unary op, precedence in NEG_PREC #define, below */
  36. #define    NEG    13
  37. /* symantically operands, ie, constants, variables and all functions */
  38. #define    CONST    14    
  39. #define    VAR    15
  40. #define    ABS    16    /* add functions if desired just like this is done */
  41. #define    SQRT    17    /* add functions if desired just like this is done */
  42. /* purely tokens - never get compiled as such */
  43. #define    LPAREN    255
  44. #define    RPAREN    254
  45. #define    ERR    (-1)
  46.  
  47. /* precedence of each of the binary operators.
  48.  * in case of a tie, compiler associates left-to-right.
  49.  * N.B. each entry's index must correspond to its #define!
  50.  */
  51. static int precedence[] = {0,5,5,6,6,2,1,4,4,3,3,4,4};
  52. #define    NEG_PREC    7    /* negation is highest */
  53.  
  54. /* execute-time operand stack */
  55. #define    MAX_STACK    16
  56. static double stack[MAX_STACK], *sp;
  57.  
  58. /* space for compiled opcodes - the "program".
  59.  * opcodes go in lower 8 bits.
  60.  * when an opcode has an operand (as CONST and VAR) it is really in opx[] and
  61.  *   the index is in the remaining upper bits.
  62.  */
  63. #define    MAX_PROG 32
  64. static int program[MAX_PROG], *pc;
  65. #define    OP_SHIFT    8
  66. #define    OP_MASK        0xff
  67.  
  68. /* auxiliary operand info.
  69.  * the operands (all but lower 8 bits) of CONST and VAR are really indeces
  70.  * into this array. thus, no point in making this any longer than you have
  71.  * bits more than 8 in your machine's int to index into it, ie, make
  72.  *    MAX_OPX <= 1 << ((sizeof(int)-1)*8)
  73.  * also, the fld's must refer to ones being flog'd, so not point in more
  74.  * of these then that might be used for plotting and srching combined.
  75.  */
  76. #define    MAX_OPX    16
  77. typedef union {
  78.     double opu_f;        /* value when opcode is CONST */
  79.     int opu_fld;        /* rcfpack() of field when opcode is VAR */
  80. } OpX;
  81. static OpX opx[MAX_OPX];
  82. static int opxidx;
  83.  
  84. /* these are global just for easy/rapid access */
  85. static int parens_nest;    /* to check that parens end up nested */
  86. static char *err_msg;    /* caller provides storage; we point at it with this */
  87. static char *cexpr, *lcexpr; /* pointers that move along caller's expression */
  88. static int good_prog;    /* != 0 when program appears to be good */
  89.  
  90. /* compile the given c-style expression.
  91.  * return 0 and set good_prog if ok,
  92.  * else return -1 and a reason message in errbuf.
  93.  */
  94. compile_expr (ex, errbuf)
  95. char *ex;
  96. char *errbuf;
  97. {
  98.     int instr;
  99.  
  100.     /* init the globals.
  101.      * also delete any flogs used in the previous program.
  102.      */
  103.     cexpr = ex;
  104.     err_msg = errbuf;
  105.     pc = program;
  106.     opxidx = 0;
  107.     parens_nest = 0;
  108.     do {
  109.         instr = *pc++;
  110.         if ((instr & OP_MASK) == VAR)
  111.         flog_delete (opx[instr >> OP_SHIFT].opu_fld);
  112.     } while (instr != HALT);
  113.  
  114.     pc = program;
  115.     if (compile(0) == ERR) {
  116.         (void) sprintf (err_msg + strlen(err_msg), " at \"%.10s\"", lcexpr);
  117.         good_prog = 0;
  118.         return (-1);
  119.     }
  120.     *pc++ = HALT;
  121.     good_prog = 1;
  122.     return (0);
  123. }
  124.  
  125. /* execute the expression previously compiled with compile_expr().
  126.  * return 0 with *vp set to the answer if ok, else return -1 with a reason
  127.  * why not message in errbuf.
  128.  */
  129. execute_expr (vp, errbuf)
  130. double *vp;
  131. char *errbuf;
  132. {
  133.     int s;
  134.  
  135.     err_msg = errbuf;
  136.     sp = stack + MAX_STACK;    /* grows towards lower addresses */
  137.     pc = program;
  138.     s = execute(vp);
  139.     if (s < 0)
  140.         good_prog = 0;
  141.     return (s);
  142. }
  143.  
  144. /* this is a way for the outside world to ask whether there is currently a
  145.  * reasonable program compiled and able to execute.
  146.  */
  147. prog_isgood()
  148. {
  149.     return (good_prog);
  150. }
  151.  
  152. /* get and return the opcode corresponding to the next token.
  153.  * leave with lcexpr pointing at the new token, cexpr just after it.
  154.  * also watch for mismatches parens and proper operator/operand alternation.
  155.  */
  156. static
  157. next_token ()
  158. {
  159.     static char toomt[] = "More than %d terms";
  160.     static char badop[] = "Illegal operator";
  161.     int tok = ERR;    /* just something illegal */
  162.     char c;
  163.  
  164.     while ((c = *cexpr) == ' ')
  165.         cexpr++;
  166.     lcexpr = cexpr++;
  167.  
  168.     /* mainly check for a binary operator */
  169.     switch (c) {
  170.     case '\0': --cexpr; tok = HALT; break; /* keep returning HALT */
  171.     case '+': tok = ADD; break; /* compiler knows when it's really unary */
  172.     case '-': tok = SUB; break; /* compiler knows when it's really negate */
  173.     case '*': tok = MULT; break;
  174.     case '/': tok = DIV; break;
  175.     case '(': parens_nest++; tok = LPAREN; break;
  176.     case ')':
  177.         if (--parens_nest < 0) {
  178.             (void) sprintf (err_msg, "Too many right parens");
  179.         return (ERR);
  180.         } else
  181.         tok = RPAREN;
  182.         break;
  183.     case '|':
  184.         if (*cexpr == '|') { cexpr++; tok = OR; }
  185.         else { (void) sprintf (err_msg, badop); return (ERR); }
  186.         break;
  187.     case '&':
  188.         if (*cexpr == '&') { cexpr++; tok = AND; }
  189.         else { (void) sprintf (err_msg, badop); return (ERR); }
  190.         break;
  191.     case '=':
  192.         if (*cexpr == '=') { cexpr++; tok = EQ; }
  193.         else { (void) sprintf (err_msg, badop); return (ERR); }
  194.         break;
  195.     case '!':
  196.         if (*cexpr == '=') { cexpr++; tok = NE; }
  197.         else { (void) sprintf (err_msg, badop); return (ERR); }
  198.         break;
  199.     case '<':
  200.         if (*cexpr == '=') { cexpr++; tok = LE; }
  201.         else tok = LT;
  202.         break;
  203.     case '>':
  204.         if (*cexpr == '=') { cexpr++; tok = GE; }
  205.         else tok = GT;
  206.         break;
  207.     }
  208.  
  209.     if (tok != ERR)
  210.         return (tok);
  211.  
  212.     /* not op so check for a constant, variable or function */
  213.     if (isdigit(c) || c == '.') {
  214.         if (opxidx > MAX_OPX) {
  215.         (void) sprintf (err_msg, toomt, MAX_OPX);
  216.         return (ERR);
  217.         }
  218.         opx[opxidx].opu_f = atof (lcexpr);
  219.         tok = CONST | (opxidx++ << OP_SHIFT);
  220.         skip_double();
  221.     } else if (isalpha(c)) {
  222.         /* check list of functions */
  223.         if (strncmp (lcexpr, "abs", 3) == 0) {
  224.         cexpr += 2;
  225.         tok = ABS;
  226.         } else if (strncmp (lcexpr, "sqrt", 4) == 0) {
  227.         cexpr += 3;
  228.         tok = SQRT;
  229.         } else {
  230.         /* not a function, so assume it's a variable */
  231.         int fld;
  232.         if (opxidx > MAX_OPX) {
  233.             (void) sprintf (err_msg, toomt, MAX_OPX);
  234.             return (ERR);
  235.         }
  236.         fld = parse_fieldname ();
  237.         if (fld < 0) {
  238.             (void) sprintf (err_msg, "Unknown field");
  239.             return (ERR);
  240.         } else {
  241.             if (flog_add (fld) < 0) { /* register with field logger */
  242.             (void) sprintf (err_msg, "Sorry; too many fields");
  243.             return (ERR);
  244.             }
  245.             opx[opxidx].opu_fld = fld;
  246.             tok = VAR | (opxidx++ << OP_SHIFT);
  247.         }
  248.         }
  249.     }
  250.  
  251.     return (tok);
  252. }
  253.  
  254. /* move cexpr on past a double.
  255.  * allow sci notation.
  256.  * no need to worry about a leading '-' or '+' but allow them after an 'e'.
  257.  * TODO: this handles all the desired cases, but also admits a bit too much
  258.  *   such as things like 1eee2...3. geeze; to skip a double right you almost
  259.  *   have to go ahead and crack it!
  260.  */
  261. static
  262. skip_double()
  263. {
  264.     int sawe = 0;    /* so we can allow '-' or '+' right after an 'e' */
  265.  
  266.     while (1) {
  267.         char c = *cexpr;
  268.         if (isdigit(c) || c=='.' || (sawe && (c=='-' || c=='+'))) {
  269.         sawe = 0;
  270.         cexpr++;
  271.         } else if (c == 'e') {
  272.         sawe = 1;
  273.         cexpr++;
  274.         } else
  275.         break;
  276.     }
  277. }
  278.  
  279. /* call this whenever you want to dig out the next (sub)expression.
  280.  * keep compiling instructions as long as the operators are higher precedence
  281.  * than prec, then return that "look-ahead" token that wasn't (higher prec).
  282.  * if error, fill in a message in err_msg[] and return ERR.
  283.  */
  284. static
  285. compile (prec)
  286. int prec;
  287. {
  288.     int expect_binop = 0;    /* set after we have seen any operand.
  289.                  * used by SUB so it can tell if it really 
  290.                  * should be taken to be a NEG instead.
  291.                  */
  292.     int tok = next_token ();
  293.  
  294.         while (1) {
  295.         int p;
  296.         if (tok == ERR)
  297.         return (ERR);
  298.         if (pc - program >= MAX_PROG) {
  299.         (void) sprintf (err_msg, "Program is too long");
  300.         return (ERR);
  301.         }
  302.  
  303.         /* check for special things like functions, constants and parens */
  304.             switch (tok & OP_MASK) {
  305.             case HALT: return (tok);
  306.         case ADD:
  307.         if (expect_binop)
  308.             break;    /* procede with binary addition */
  309.         /* just skip a unary positive(?) */
  310.         tok = next_token();
  311.         continue;
  312.         case SUB:
  313.         if (expect_binop)
  314.             break;    /* procede with binary subtract */
  315.         tok = compile (NEG_PREC);
  316.         *pc++ = NEG;
  317.         expect_binop = 1;
  318.         continue;
  319.             case ABS: /* other funcs would be handled the same too ... */
  320.         case SQRT:
  321.         /* eat up the function parenthesized argument */
  322.         if (next_token() != LPAREN || compile (0) != RPAREN) {
  323.             (void) sprintf (err_msg, "Function arglist error");
  324.             return (ERR);
  325.         }
  326.         /* then handled same as ... */
  327.             case CONST: /* handled same as... */
  328.         case VAR:
  329.         *pc++ = tok;
  330.         tok = next_token();
  331.         expect_binop = 1;
  332.         continue;
  333.             case LPAREN:
  334.         if (compile (0) != RPAREN) {
  335.             (void) sprintf (err_msg, "Unmatched left paren");
  336.             return (ERR);
  337.         }
  338.         tok = next_token();
  339.         expect_binop = 1;
  340.         continue;
  341.             case RPAREN:
  342.         return (RPAREN);
  343.             }
  344.  
  345.         /* everything else is a binary operator */
  346.         p = precedence[tok];
  347.             if (p > prec) {
  348.                 int newtok = compile (p);
  349.         if (newtok == ERR)
  350.             return (ERR);
  351.                 *pc++ = tok;
  352.         expect_binop = 1;
  353.                 tok = newtok;
  354.             } else
  355.                 return (tok);
  356.         }
  357. }
  358.  
  359. /* "run" the program[] compiled with compile().
  360.  * if ok, return 0 and the final result,
  361.  * else return -1 with a reason why not message in err_msg.
  362.  */
  363. static
  364. execute(result)
  365. double *result;
  366. {
  367.     int instr; 
  368.  
  369.     do {
  370.         instr = *pc++;
  371.         switch (instr & OP_MASK) {
  372.         /* put these in numberic order so hopefully even the dumbest
  373.          * compiler will choose to use a jump table, not a cascade of ifs.
  374.          */
  375.         case HALT: break;    /* outer loop will stop us */
  376.         case ADD:  sp[1] = sp[1] +  sp[0]; sp++; break;
  377.         case SUB:  sp[1] = sp[1] -  sp[0]; sp++; break;
  378.         case MULT: sp[1] = sp[1] *  sp[0]; sp++; break;
  379.         case DIV:  sp[1] = sp[1] /  sp[0]; sp++; break;
  380.         case AND:  sp[1] = sp[1] && sp[0] ? 1 : 0; sp++; break;
  381.         case OR:   sp[1] = sp[1] || sp[0] ? 1 : 0; sp++; break;
  382.         case GT:   sp[1] = sp[1] >  sp[0] ? 1 : 0; sp++; break;
  383.         case GE:   sp[1] = sp[1] >= sp[0] ? 1 : 0; sp++; break;
  384.         case EQ:   sp[1] = sp[1] == sp[0] ? 1 : 0; sp++; break;
  385.         case NE:   sp[1] = sp[1] != sp[0] ? 1 : 0; sp++; break;
  386.         case LT:   sp[1] = sp[1] <  sp[0] ? 1 : 0; sp++; break;
  387.         case LE:   sp[1] = sp[1] <= sp[0] ? 1 : 0; sp++; break;
  388.         case NEG:  *sp = -*sp; break;
  389.         case CONST: *--sp = opx[instr >> OP_SHIFT].opu_f; break;
  390.         case VAR:
  391.         if (flog_get(opx[instr>>OP_SHIFT].opu_fld, --sp, (char *)0)<0) {
  392.             (void) sprintf (err_msg, "Bug! VAR field not logged");
  393.             return (-1);
  394.         }
  395.         break;
  396.         case ABS:  *sp = fabs (*sp); break;
  397.         case SQRT: *sp = sqrt (*sp); break;
  398.         default:
  399.         (void) sprintf (err_msg, "Bug! bad opcode: 0x%x", instr);
  400.         return (-1);
  401.         }
  402.         if (sp < stack) {
  403.         (void) sprintf (err_msg, "Runtime stack overflow");
  404.         return (-1);
  405.         } else if (sp - stack > MAX_STACK) {
  406.         (void) sprintf (err_msg, "Bug! runtime stack underflow");
  407.         return (-1);
  408.         }
  409.     } while (instr != HALT);
  410.  
  411.     /* result should now be on top of stack */
  412.     if (sp != &stack[MAX_STACK - 1]) {
  413.         (void) sprintf (err_msg, "Bug! stack has %d items",
  414.                             MAX_STACK - (sp-stack));
  415.         return (-1);
  416.     }
  417.     *result = *sp;
  418.     return (0);
  419. }
  420.  
  421. /* starting with lcexpr pointing at a string expected to be a field name,
  422.  * return an rcfpack(r,c,0) of the field else -1 if bad.
  423.  * when return, leave lcexpr alone but move cexpr to just after the name.
  424.  */
  425. static
  426. parse_fieldname ()
  427. {
  428.     int r = -1, c = -1;     /* anything illegal */
  429.     char *fn = lcexpr;    /* likely faster than using the global */
  430.     char f0, f1;
  431.     char *dp;
  432.  
  433.     /* search for first thing not an alpha char.
  434.      * leave it in f0 and leave dp pointing to it.
  435.      */
  436.     dp = fn;
  437.     while (isalpha(f0 = *dp))
  438.         dp++;
  439.  
  440.     /* crack the new field name.
  441.      * when done trying, leave dp pointing at first char just after it.
  442.      * set r and c if we recognized it.
  443.      */
  444.     if (f0 == '.') {
  445.         int jcontext = 0;    /* need more of then as time goes on */
  446.  
  447.         /* object.column "dot" notation pair.
  448.          * crack the first portion (pointed to by fn): set r.
  449.          * then the second portion (pointed to by dp+1): set c.
  450.          */
  451.         f0 = fn[0];
  452.         f1 = fn[1];
  453.         switch (f0) {
  454.         case 'c':            r = R_CALLISTO;
  455.         break;
  456.         case 'e':            r = R_EUROPA;
  457.         break;
  458.         case 'g':            r = R_GANYMEDE;
  459.         break;
  460.         case 'i':            r = R_IO;
  461.         break;
  462.         case 'j':
  463.                     r = R_JUPITER;
  464.         jcontext = 1;
  465.         break;
  466.         case 'm':
  467.         if (f1 == 'a')      r = R_MARS;
  468.         else if (f1 == 'e') r = R_MERCURY;
  469.         else if (f1 == 'o') r = R_MOON;
  470.         break;
  471.         case 'n':            r = R_NEPTUNE;
  472.         break;
  473.         case 'p':            r = R_PLUTO;
  474.         break;
  475.         case 's':
  476.         if (f1 == 'a')      r = R_SATURN;
  477.         else if (f1 == 'u') r = R_SUN;
  478.         break;
  479.         case 'u':            r = R_URANUS;
  480.         break;
  481.         case 'x':            r = R_OBJX;
  482.         break;
  483.         case 'y':            r = R_OBJY;
  484.         break;
  485.         case 'v':            r = R_VENUS;
  486.         break;
  487.         }
  488.  
  489.         /* now crack the column (stuff after the dp) */
  490.         dp++;    /* point at good stuff just after the decimal pt */
  491.         f0 = dp[0];
  492.         f1 = dp[1];
  493.         switch (f0) {
  494.         case 'a':
  495.         if (f1 == 'l')        c = C_ALT;
  496.         else if (f1 == 'z')   c = C_AZ;
  497.         break;
  498.         case 'd':              c = C_DEC;
  499.         break;
  500.         case 'e':
  501.         if (f1 == 'd')        c = C_EDIST;
  502.         else if (f1 == 'l')   c = C_ELONG;
  503.         break;
  504.         case 'h':
  505.         if (f1 == 'l') {
  506.             if (dp[2] == 'a')              c = C_HLAT;
  507.             else if (dp[2] == 'o')         c = C_HLONG;
  508.         } else if (f1 == 'r' || f1 == 'u') c = C_TUP;
  509.         break;
  510.         case 'j':              c = C_JUPITER;
  511.         break;
  512.         case 'm':
  513.         if (f1 == 'a')        c = C_MARS;
  514.         else if (f1 == 'e')   c = C_MERCURY;
  515.         else if (f1 == 'o')   c = C_MOON;
  516.         break;
  517.         case 'n':              c = C_NEPTUNE;
  518.         break;
  519.         case 'p':
  520.         if (f1 == 'h')        c = C_PHASE;
  521.         else if (f1 == 'l')   c = C_PLUTO;
  522.         break;
  523.         case 'r':
  524.         if (f1 == 'a') {
  525.             if (dp[2] == 'z') c = C_RISEAZ;
  526.             else           c = C_RA;
  527.         } else if (f1 == 't') c = C_RISETM;
  528.         break;
  529.         case 's':
  530.         if (f1 == 'a') {
  531.             if (dp[2] == 'z') c = C_SETAZ;
  532.             else          c = C_SATURN;
  533.         } else if (f1 == 'd') c = C_SDIST;
  534.         else if (f1 == 'i')   c = C_SIZE;
  535.         else if (f1 == 't')   c = C_SETTM;
  536.         else if (f1 == 'u')   c = C_SUN;
  537.         break;
  538.         case 't':
  539.         if (f1 == 'a')        c = C_TRANSALT;
  540.         else if (f1 == 't')   c = C_TRANSTM;
  541.         break;
  542.         case 'u':              c = C_URANUS;
  543.         break;
  544.         case 'x':              c = jcontext ? C_OBJX : C_JMX;
  545.         break;
  546.         case 'y':              c = jcontext ? C_OBJY : C_JMY;
  547.         break;
  548.         case 'z':              c = C_JMZ;
  549.         break;
  550.         case 'v':
  551.         if (f1 == 'e')        c = C_VENUS;
  552.         else if (f1 == 'm')   c = C_MAG;
  553.         break;
  554.         }
  555.  
  556.         /* now skip dp on past the column stuff */
  557.         while (isalpha(*dp))
  558.         dp++;
  559.     } else {
  560.         /* no decimal point; some other field */
  561.         f0 = fn[0];
  562.         f1 = fn[1];
  563.         switch (f0) {
  564.         case 'd':
  565.         if (f1 == 'a')      r = R_DAWN, c = C_DAWNV;
  566.         else if (f1 == 'u') r = R_DUSK, c = C_DUSKV;
  567.         break;
  568.         case 'j':
  569.         if (f1 == 'I') {
  570.             if (fn[2] == 'I') r = R_JCML, c = C_JCMLSII;
  571.             else           r = R_JCML, c = C_JCMLSI;
  572.         }
  573.         break;
  574.         case 'n':
  575.         r = R_LON, c = C_LONV;
  576.         break;
  577.         }
  578.     }
  579.  
  580.     cexpr = dp;
  581.     if (r <= 0 || c <= 0) return (-1);
  582.     return (rcfpack (r, c, 0));
  583. }
  584.